unit decor;
interface
uses common;
Var de_th : myreal;

function node_z_alligned(p,height:integer):integer;
function t2t(i,j:integer):integer;
function fpath(iss,dp:integer; p:vpath; var v:vpath):boolean;
procedure table_init;
function check_node_object(po,j,k:integer; Var ofla,ocl : integer):boolean;
procedure pat_instance_dep(po : integer;Var fln:nodelist);
procedure new_pat_instance(po : integer;reset:integer);
procedure new_node_objects(po,uat : integer);

implementation
uses tools;

function node_z_alligned(p,height:integer):integer;
var i,k : integer;
begin
   i:=0; repeat i:=i+1;  {find first bond across given height}
      k:=ltm[p,height,i];
   until ((k>0) or (i=10));
   if ((k=0) and (i=10)) then begin
      {writeln('node-z-alligned: vertex ',p:1,': lost vertical connectivity.');}
      {halt;}
   end;
   node_z_alligned:=lt[k,po(i+5)];
end;
function t2t(i,j:integer):integer;
var ds,m1,m2,min2,o :integer;
begin
   min2:=10000;
   m1:=((i-1) div tnodes0);
   m2:=((j-1) div tnodes0);
   for o:=-1 to 1 do if abs(m2-m1+o*multi)<abs(min2) then min2:=m2-m1+o*multi;
   {if abs(min2)>0 then
      writeln('t2t : ',m2:1,' ',m1:1,' ',min2:1);}
   t2t:=min2;
end;
procedure table_init;
var
   i,j,o,k,kk	  : integer;
   i0,j0,k0	  : integer;
   eps,xx,d2	  : myreal;
   i1,i2,j1,j2,tn : integer;
   ds		  : integer;
   u,v,w	  : v2;
   meoc		  : array[1..t_ele] of integer;
begin
   {init node-object-flavour record}
   for o:=1 to t_ele do meoc[o]:=mele_oc[o];
   d2:=1/tau/tau;
   for i:=1 to tdim do
      for j:=1 to obj_of_node do begin
	 n_obj_fl[i,j]:=1; {flavour of an object}
	 n_obj_cl[i,j]:=1; {color of an object}
      end;
   i1:=0; i2:=0;
   if (tnodes0<50) then begin i1:=1; i2:=1; end; {for small unit cells}
   eps:=0.001;
   for i:=1 to tnodes do begin
      for j:=1 to 10 do lt[i,j]:=0;
   end;
   for i:=1 to tnodes do nv[i]:=0;
   for kk:=0 to multi-1 do begin
      for i:=kk*tnodes0+1 to (kk+1)*tnodes0 do
	 for j:=i to (kk+1)*tnodes0 do
	    for j1:=-i1 to i1 do
	       for j2:=-i2 to i2 do begin
		  for o:=1 to 2 do v[o]:=bound(rt[j,o]-rt[i,o]);
		  v[1]:=v[1]+j1; v[2]:=v[2]+j2;
		  ortho(v,u);
		  if (absv(u)-1.0<eps) then begin
		     for k:=1 to 10 do begin
			xx:=sp(u,re[k]);
			if (abs(xx-1.0)<eps) then begin
			   nv[i]:=nv[i]+1;
			   lt[i,k]:=j;
			   nv[j]:=nv[j]+1;
			   lt[j,po(k+5)]:=i;
			end;
		     end;
		  end;
	       end;
   end;
   for o:=1 to 10 do nn[o]:=0;
   for i:=1 to tnodes do nn[nv[i]]:=nn[nv[i]]+1;
   {stacked tilings connectivity}
   for i:=1 to tnodes do begin
      for o:=-1 to 1 do ltc[i,o]:=0;
      for j:=0 to 10 do
	 for o:=-1 to 1 do ltm[i,o,j]:=0;
   end;
   for i:=1 to tnodes do for o:=-1 to 1 do nvm[i,o]:=0;
   for i:=1 to tnodes do
      for j:=i+1 to tnodes do begin
	 ds:=t2t(i,j);
	 if abs(ds)<2 then begin
	    for j1:=-i1 to i1 do
	       for j2:=-i2 to i2 do begin
		  for o:=1 to 2 do v[o]:=bound(rt[j,o]-rt[i,o]);
		  v[1]:=v[1]+j1; v[2]:=v[2]+j2;
		  ortho(v,u);
		  if (absv(u)<eps) then begin
		     ltm[i,ds,0]:=j;
		     ltm[j,-ds,0]:=i;
		     if (multi=2) then begin {periodic boundary for multi=2}
			ltm[i,-ds,0]:=j;
			ltm[j,ds,0]:=i;
		     end;
		  end;
		  {this is for two types of rhombus hexa-flips}
		  if (not(sigmaflip) and (nv[i]=3) and (nv[j]=3)) then begin
		     for o:=1 to 2 do w[o]:=u[o];
		     {generate flipped position of the "top/bottom" vertex}
		     for k:=1 to 10 do if (lt[j,k]>0) then begin
			for o:=1 to 2 do w[o]:=w[o]+re[k,o];
		     end;
		     if (absv(w)<eps) then begin
			ltc[i,ds]:=j;
			ltc[j,-ds]:=i;
			if (multi=2) then begin
			   ltc[i,-ds]:=j;
			   ltc[j,ds]:=i;
			end;
		     end;
		  end;
		  {this is for sigma-flip in two-level tiling}
		  if sigmaflip then if (abs(absv(u)-d2)<eps) then begin
		     ltc[i,ds]:=j;
		     ltc[j,-ds]:=i;
		     if (multi=2) then begin
			ltc[i,-ds]:=j;
			ltc[j,ds]:=i;
		     end;
		  end;
		  if (abs(absv(u)-1.0)<eps) then begin
		     for k:=1 to 10 do begin
			xx:=sp(u,re[k]);
			if (abs(xx-1.0)<eps) then begin
			   nvm[i,ds]:=nvm[i,ds]+1;
			   ltm[i,ds,k]:=j;
			   nvm[j,-ds]:=nvm[j,-ds]+1;
			   ltm[j,-ds,po(k+5)]:=i;
			   if multi=2 then begin {periodic boundary for multi=2}
			      nvm[i,-ds]:=nvm[i,-ds]+1;
			      ltm[i,-ds,k]:=j;
			      nvm[j,ds]:=nvm[j,ds]+1;
			      ltm[j,ds,po(k+5)]:=i;
			   end;
			end;
		     end;
		  end;
	       end;
	 end;
      end;   
   for i:=1 to tnodes do ltm[i,0,0]:=i; {needed for generality}
   if (multi=1) then begin
      for i:=1 to tnodes do begin
	 for o:=-1 to 1 do begin
	    ltm[i,o,0]:=i;
	    for j:=1 to 10 do ltm[i,o,j]:=lt[i,j];
	 end;
      end;
   end;
   if (io3d>0) then begin
      for i:=1 to tnodes do begin
	 for o:=-1 to 1 do if (o<>0) then begin
	    if ((ltm[i,o,0]=0) and (ltc[i,o]=0)) then begin
	       {writeln('Table init, node ',i:1,': Z-connectivity error; LTM=0 and ltc=0');}
	       {halt;}
	    end;
	 end;
      end;
   end;
   if (debug[7]) then begin
      writeln('Connectivity table: ');
      for i:=1 to tnodes do begin
	 write(i:1,' -> ');
	 for j:=1 to 10 do write(lt[i,j]:1,' ');
	 if(io3d>0) then begin
	    for o:=-1 to 1 do if (o<>0) then begin
	       if(o<0) then write(' - ') else write(' + ');
	       for j:=1 to 10 do write(ltm[i,o,j]:1,' ');
	       write('c=',ltc[i,o]:1,' ');
	    end;
	 end;
	 writeln;
      end;
   end;
end; { initialize_table }
function fpath(iss,dp:integer; p:vpath; var v:vpath):boolean;
var i,j,ref,j0 : integer;
   failed   : boolean;
begin
   for i:=1 to dp do v[i]:=0;
   failed:=false; if (dp>0) then begin
      i:=0; j:=iss; ref:=p[1]; p[1]:=0; repeat i:=i+1;
	 if ((j=0) and (abs(p[i])<>5)) then failed:=true else begin
	    if ((j=0) and (abs(p[i])=5)) then begin {RETURN TO PREVIOUS VERTEX}
	       ref:=po(ref+p[i]);
	       j:=j0;
	    end else begin {NORMAL ADVANCE ALONG THE PATH}
	       ref:=po(ref+p[i]);
	       if (lt[j,ref]=0) then j0:=j; {save this position}
	       j:=lt[j,ref];
	       v[i]:=j;
	    end;
	 end;
	 {writeln('fpath: ',i:1,' ',j:1,' ',nu[j]:1,' ',po(ref):1,' ',failed);}
      until ((i=dp) or failed);
   end;
   fpath:=not(failed);
end; { fpath }
procedure new_node_atoms(po,m,fla,co : integer; var mu:integer);
var
   j,k,l,n,o,mu0,muo,muo0,lr : integer;
   rn5,rnm,fl		     : integer;
   ch10			     : i10;
   u,v			     : v2;
   x			     : myreal;
begin
   {debug[2]:=true; debug[9]:=true;}
   if (mu>at_of_node) then begin
      writeln('Insufficient dimension at_of_node=',at_of_node:1,' in common.p .');
      halt;
   end;
   mu0:=mu;
   j:=n_objpo[po,m,1]; {object ptr}
   k:=n_objpo[po,m,2]; {rotational variant}
   fl:=(co-1)*obj_nfl[j]+fla;
   {writeln(' newnodeatoms ',j:1,' ',k:1,' ',obj_at_mu[j,k]:1);}
   muo0:=0; muo:=0;
   if GBFLIP then begin {generate random numbers, FIXED for ALL orbits}
      x:=randu(seed)*5; {random number for 5-fold rotation [1-5]}
      rn5:=round(x+0.5);
      if (rn5=0) then rn5:=1; if (rn5>5) then rn5:=5;
      x:=randu(seed)*2; {random number for mirror: [1-2]}
      rnm:=round(x+0.5);
      if (rnm=0) then rnm:=1; if (rnm>2) then rnm:=2;
   end;
   {rnm:=1;}
   {if debug[9] then writeln;}
   {for l:=1 to obj_at_mu[j,k] do write(' ',bi[j,k,l,9]:1,':',fl:1); writeln;}
   for l:=1 to obj_at_mu[j,k] do if (bi[j,k,l,9]=fl) then begin
      if debug[2] then writeln('  atom ',l:1,',',bi[j,k,l,9]:1,',',atp[j,k,l,1]:1,' ',fla:1,fl:1,co:1);
      mu:=mu+1;
      if(mu>at_of_node)then begin
	 writeln('decor.p: Insufficient dimension at_of_node: ',mu:1,' in common.p.');
	 halt;
      end;
      {note: this is list of object_atoms, need to figure out the orbits!}
      if osb[atp[j,k,l,2]] then begin {randomly reshuffle record of chemistries}
	 muo0:=muo0+1;
	 if (muo0=1) then begin
	    muo:=omu[atp[j,k,l,2]];
	    for n:=1 to 10 do ch10[n]:=0;
	    for n:=1 to muo do ch10[n]:=atp[j,k,l+n-1,1];
	    if (muo>1) then SHUFFLE(muo,rn5,rnm,ch10);
	    if (debug[9] and osb[atp[j,k,l,2]] and (muo>1)) then begin
	       write('node ',po:1,' SYM-BREAK orb=',atp[j,k,l,2]:1,' mu=',muo:1,' choice ');
	       if(muo<=2) then write(rnm:1) else write(rn5:1);
	       write(' chlist ');
	       for o:=1 to muo do write(ch10[o]:1,' ');
	       writeln;
	    end;
	 end;
	 n_a[po,mu,1]:=ch10[muo0];
	 {writeln(lr:1,' ',l:1,'  ',muo0:1,'/',muo:1,'    ',n_a[po,mu,1]:1,' ',atp[j,k,l,1]:1);}
	 if (muo0=muo) then muo0:=0;
      end else n_a[po,mu,1]:=atp[j,k,l,1];
      n_a[po,mu,2]:=atp[j,k,l,2]; {absolute orbit #}
      nat:=nat+1; n_a[po,mu,3]:=nat;
      n_a[po,mu,4]:=j; n_a[po,mu,5]:=obj_st[j];
      n_para[po,mu]:=bi[j,k,l];
      para2xyz(n_para[po,mu],n_a[po,mu,1],1,1,n_r[po,mu]);
      if repre5 then n_r5[po,mu]:=ra5[j,k,l];
   end;
   if (debug[2]) then writeln(' total added ',(mu-mu0):1,' atoms');
end; { new_node_atoms }

function check_node_object(po,j,k:integer; Var ofla,ocl : integer):boolean;
var
   i,l,o	  : integer;
   a		  : array[-1..1] of i10;
   ap		  : array[-1..1] of vpath;
   ab,apb	  : array[-1..1] of boolean;
   ap0		  : vpath;
   pat_ok,path_ok : boolean;
   seed0	  : longint;
   x		  : myreal;
begin		  
   check_node_object:=false;
   {if(debug[3]) then begin
   write('DECOR (',j:1,') ',obj_mu[j]:1,' ',nu[po]:1,' -> ');
   for k:=1 to obj_mu[j] do write(obj_nu[j,k]:1,' '); writeln;
      end;}
   if ((nu[po]=obj_nu[j,k]) or not(flavours)) then begin {loop OBJ-MULT}
      pat_ok:=true;
      if (pat_ok) then pat_ok:=teq10(lt[po],obj_pat_list[j,k,0],a[0]);
      if(po<0) then begin
	 write('dbgCHKNDOBJ ',obj_name[j],' ');
	 for o:=1 to 10 do write(lt[po,o]:1,','); write('  ');
	 for o:=1 to 10 do write(obj_pat_list[j,k,0,o]:1); write('  ');
	 for o:=1 to 10 do write(a[0,o]:1,','); writeln(' ',pat_ok);
      end;
      for o:=1 to 10 do if (a[0,o]>0) then m2m[a[0,o]]:=true;
      if ((pat_ok) and (io3d>0)) then begin {test top/bottom pattern}
	 for o:=-io3d to io3d do if (o<>0) then begin
	    for l:=1 to 10 do begin
	       if not(teq_node(ltm[po,o,l],obj_pat_list[j,k,o,l])) then pat_ok:=false else a[o,l]:=ltm[po,o,l];
	       a[o,l]:=ltm[po,o,l];
	       if (obj_pat_list[j,k,o,l]=2) then a[o,l]:=-a[o,l];
	       if (a[o,l]>0) then m2m[a[o,l]]:=true;
	    end;
	 end;
      end;
      path_ok:=(obj_pth[j]=0);
      if (pat_ok and not(path_ok)) then begin
	 path_ok:=fpath(po,obj_pth[j],obj_pth_def[j,k],ap0);
	 if (path_ok) then begin
	    {Note: now path MAY contain zeros!}
	    for l:=1 to obj_pth[j] do if path_ok then begin
	       {test level0}
	       path_ok:=teq_node(ap0[l],obj_pth_stat[j,0,l]);
	       if path_ok then begin
		  ap[0,l]:=ap0[l];
		  if (obj_pth_stat[j,0,l]=2) then ap[0,l]:=-ap[0,l];
		  if(ap[0,l]>0) then m2m[ap[0,l]]:=true;
	       end;
	       {test up/down}
	       if (path_ok and (io3d>0)) then begin
		  for o:=-io3d to io3d do if ((o<>0) and path_ok) then begin
		     {ap0=0 AND path_status=2 is OK}
		     if (ap0[l]=0) then begin
			if (obj_pth_stat[j,o,l]=2) then ap[o,l]:=0 else path_ok:=false; {vertex above nonexistent vertex is not checked}
		     end else begin
			path_ok:=teq_node(ltm[ap0[l],o,0],obj_pth_stat[j,o,l]);
			if path_ok then begin {keep record}
			   ap[o,l]:=ap0[l];
			   if (obj_pth_stat[j,o,l]=2) then
			      ap[o,l]:=-ap[o,l];
			   if(ap[o,l]>0) then m2m[ap[o,l]]:=true;
			end;
		     end;
		  end;
	       end; {end 3d test}
	    end; {end obj_path} 
	 end;
      end;
      if (pat_ok and path_ok) then begin
	 check_node_object:=true;
	 ofla:=1;
	 if (obj_nfl[j]>1) then begin
	    seed0:=seed;
	    x:=randu(seed);
	    ofla:=round(x*obj_nfl[j]+0.5);
	    {2 lines below: shouldnt ever happen, but...}
	    if (ofla<1)then ofla:=1;
	    if (ofla>obj_nfl[j])then ofla:=obj_nfl[j];
	    if debug[9] then writeln('decor: obj-sym-break : ',obj_name[j],'   ',ofla:1,'/',obj_nfl[j]:1,'  ',seed0:1,'  ',x:1:4,' ',nobcolors[j]);
	 end;
	 ocl:=1;
	 if(nobcolors[j]>1) then begin
	    seed0:=seed;
	    x:=randu(seed);
	    ocl:=round(x*nobcolors[j]+0.5);
	    {2 lines below: shouldnt ever happen, but...}
	    if (ocl<1)then ocl:=1;
	    if (ocl>nobcolors[j])then ocl:=nobcolors[j];
	    if debug[9] then writeln('decor: obj-color : ',obj_name[j],' ',ocl:1,'/',nobcolors[j]:1,'  ',seed0:1,'  ',x:1:4);
	 end;
      end;
   end;
end; {check_node_object}

{check dependecy of pattern instances}
procedure pat_instance_dep(po : integer;Var fln:nodelist);
var
   np			 : array[-1..1] of integer;
   bn			 : array[-1..1] of boolean;
   i,j,k,l,o,ofla,kk,ocl : integer;
   seed0		 : longint;
   x			 : myreal;
   ishere,pok		 : boolean;
   node_passed		 : boolean;
   ax			 : i10;
   dbg_ipat,bb		 : boolean;
begin
   dbg_ipat:=false;
   if (debug[2] or (not(deco) and debug[3])) then writeln('node ',po:1,' PAT-INST-ADD (',instances,')');
   for j:=1 to n_obj do if (obj_nipat[j]>0) then begin
      node_passed:=teq_node(po,obj_node[j,0]);
      np[0]:=po; {trivial}
      if (io3d>0) then begin
	 for o:=-io3d to io3d do if (o<>0) then begin
	    np[o]:=0;
	    bn[o]:=teq_node(ltm[po,o,0],obj_node[j,o]);
	    if (obj_node[j,o]=1) then np[o]:=ltm[po,o,0];
	 end;
	 node_passed:=(bn[-1] and bn[1]);
      end;
      if(node_passed) then for k:=1 to obj_mu[j] do begin
	 ishere:=check_node_object(po,j,k,ofla,ocl);
	 if(ishere) then begin
	    if(obj_nipat[j]>0) then begin
	       pok:=teq10(lt[po],obj_pat_list[j,k,0],ax);
	       for o:=1 to 10 do if(ax[o]>0) then begin
		  bb:=true;
		  for l:=1 to fln[0] do if (ax[o]=fln[l]) then bb:=false;
		  if(bb) then begin
		     {writeln(po:1,' : adding node ',ax[o]:1);}
		     fln[0]:=fln[0]+1; fln[fln[0]]:=ax[o];
		     pat_instance_dep(po,fln);
		  end;
	       end;
	    end;
	 end;
      end;
   end;
end; { pat_instance_dep }
procedure new_pat_instance(po : integer;reset:integer);
var
   np			 : array[-1..1] of integer;
   bn			 : array[-1..1] of boolean;
   i,j,k,l,o,ofla,kk,ocl : integer;
   seed0		 : longint;
   x			 : myreal;
   ishere,pok		 : boolean;
   node_passed		 : boolean;
   ax			 : i10;
   dbg_ipat		 : boolean;
begin
   {We will use GLOBAl svlist a nsv, to minimize intervention...}
   {debug[9]:=true; debug[2]:=true; debug[3]:=true;}
   svn:=0;
   dbg_ipat:=false;
   if (debug[2]) then begin
      dbg_ipat:=true;
      {writeln('node ',po:1,' PAT-INST-ADD reset=',reset:1);}
   end;
   for j:=1 to n_obj do if (obj_nipat[j]>0) then begin
      node_passed:=teq_node(po,obj_node[j,0]);
      np[0]:=po; {trivial}
      if (io3d>0) then begin
	 for o:=-io3d to io3d do if (o<>0) then begin
	    np[o]:=0;
	    bn[o]:=teq_node(ltm[po,o,0],obj_node[j,o]);
	    if (obj_node[j,o]=1) then np[o]:=ltm[po,o,0];
	 end;
	 node_passed:=(bn[-1] and bn[1]);
      end;
      if(node_passed) then for k:=1 to obj_mu[j] do begin
	 ishere:=check_node_object(po,j,k,ofla,ocl);
	 {writeln('xxxx ',po:1,' ',obj_name[j],' ',ishere,' ',j:1,' ',k:1,' ',ofla:1);}
	 if(ishere) then begin
	    if(obj_nipat[j]>0) then begin
	       x:=randu(seed);
	       kk:=round(x*obj_nipat[j]+0.5);
	       {2 lines below: shouldnt ever happen, but...}
	       if (kk<1)then kk:=1;
	       if (kk>obj_nipat[j])then kk:=obj_nipat[j];
	       pok:=teq10(lt[po],obj_pat_list[j,k,0],ax);
	       if(dbg_ipat) then writeln('debug-ipat ',po:1,' ',obj_name[j],' ',j:1,',',k:1,' ',x:1:5,' ',kk:1,' of ',obj_nipat[j]:1,' reset=',reset:1,'  ');
	       {we reset regardless of whether obj_pat_ilist was < 0 or not... not sure its fine}
	       {we only set instance if < 0}
	       if(obj_inst[j,kk]<0) then begin
		  svn:=svn+1; svlist[svn]:=po;
		  if(reset=1) then begin
		     tvl[po]:=-ttvl;
		     tvlpo[po]:=0;
		  end else begin
		     tvl[po]:=obj_inst[j,kk];
		     tvlpo[po]:=po;
		  end;
		  if dbg_ipat then writeln(' * set inst ',po:1," to ",tvl[po]:1);
	       end;
	       {removed condition " and tvlpo[]=0" from below}
	       for o:=1 to 10 do if((ax[o]>0) and (obj_ipat_list[j,k,kk,o]<0)) then begin
		  svn:=svn+1; svlist[svn]:=ax[o];
		  if(reset=1) then begin
		     tvl[ax[o]]:=-ttvl;
		     tvlpo[ax[o]]:=0;
		  end else begin
		     tvl[ax[o]]:=obj_ipat_list[j,k,kk,o];
		     tvlpo[ax[o]]:=po;
		  end;
		  if dbg_ipat then writeln(' * set inst ',ax[o]:1," to ",tvl[ax[o]]:1);
	       end;
	    end;
	 end;
      end;
   end;
end; { new_pat_instance }
   
procedure new_node_objects(po,uat : integer);
var
   np		     : array[-1..1] of integer;
   bn		     : array[-1..1] of boolean;
   i,j,k,l,mu,nato,o : integer;
   ofla,ocl	     : integer;
   seed0	     : longint;
   x		     : myreal;
   oldfla	     : array[1..obj_of_node] of integer;
   ishere	     : boolean;
   node_passed	     : boolean;
begin
   {debug[2]:=true;}
   for i:=1 to tdim do begin n2n[po,i]:=false; end;
   {debug[9]:=true; debug[2]:=true; debug[3]:=true;}
   if(n_objmu[po]>0) then begin
      for i:=1 to n_objmu[po] do begin {keep track of old obj flavours}
	 oldfla[i]:=n_obj_fl[po,i];
      end;
   end else begin
      for i:=1 to obj_of_node do oldfla[i]:=0;
   end;
   if (n_objmu[po]>0) then begin {keep track of deleted objects...}
      if debug[2] then writeln('node ',po:1,' DELETING ');
      for j:=1 to n_objmu[po] do begin
	 k:=n_objpo[po,j,1];
	 if not(deco) then de_th:=de_th-obj_ham[k];
	 obj_st[k]:=obj_st[k]-1;
	 l:=obj_code[k];
	 if (l<99) then obj_sta[l]:=obj_sta[l]-1;
	 if (debug[3] and not(deco)) then writeln('tham subtract ',de_th:1:4,' ',obj_name[k]+' ');
      end;
   end;
   if (debug[2] or (not(deco) and debug[3])) then writeln('node ',po:1,' ADDING ');
   if deco then nato:=nan[po]; 
   mu:=0;
   for j:=1 to n_obj do begin
      for o:=1 to tdim do m2m[o]:=false;
      node_passed:=teq_node(po,obj_node[j,0]);
      {writeln('xxx ',po:1,' ',j:1,' ',obj_node[j,0]:1,' ',tvl[po]:1,' ',node_passed);}
      np[0]:=po; {trivial}
      if (io3d>0) then begin
	 for o:=-io3d to io3d do if (o<>0) then begin
	    np[o]:=0;
	    bn[o]:=teq_node(ltm[po,o,0],obj_node[j,o]);
	    if (obj_node[j,o]=1) then np[o]:=ltm[po,o,0];
	 end;
	 node_passed:=(bn[-1] and bn[1]);
      end;
      if(node_passed) then for k:=1 to obj_mu[j] do begin
	 {writeln('dbggg ',po:2,' ',j:2,' ',k:2,' ',obj_mu[j]:2,ofla:3,ocl:3,' ',obj_name[j]);}
	 ishere:=check_node_object(po,j,k,ofla,ocl);
	 {writeln('dbggg2 ',po:1,' ',obj_name[j],' ',ishere,' ',j:1,' ',k:1,' ',ofla:1);}
	 if(ishere) then begin
	    for o:=1 to tdim do if m2m[o] then n2n[po,o]:=true;
	    mu:=mu+1;
	    n_objpo[po,mu,1]:=j;
	    n_objpo[po,mu,2]:=k;
	    n_obj_fl[po,mu]:=ofla;
	    n_obj_cl[po,mu]:=ocl;
	    obj_st[j]:=obj_st[j]+1;
	    if not(deco) then de_th:=de_th+obj_ham[j];
	    l:=obj_code[j];
	    if (l<99) then obj_sta[l]:=obj_sta[l]+1;
	    if (debug[3] and not(deco)) then writeln(' tham added ',de_th:1:4,' for ',obj_name[j]);
	 end;
      end;
      n_objmu[po]:=mu;
      for o:=1 to tdim do m2m[o]:=false;
   end;
   if(deco and (uat=1)) then begin
      nan[po]:=0;
      for j:=1 to mu do begin
	 if (debug[2]) then writeln(' object ',obj_name[n_objpo[po,j,1]]);
	 if (debug[2]) then if (obj_nfl[n_objpo[po,j,1]]>1) then writeln('  nfl ',oldfla[j]:1,'->',n_obj_fl[po,j]:1,' (',obj_nfl[n_objpo[po,j,1]]:1,') ');
	 NEW_NODE_ATOMS(po,j,n_obj_fl[po,j],n_obj_cl[po,j],nan[po]);
	 if debug[2] then writeln(' atoms ',nan[po]:1,'/',nato:1);
      end;
   end;
   if debug[2] then write('NEWNODEOBJS of ',po:1,'  depend on: ');
   for j:=1 to tdim do begin
      if n2n[po,j] then begin
	 if debug[2] then write(' ',j:1);
      end;
   end;
   if debug[2] then writeln;
end; { new_node_objects }


end.
